home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / sorting.swg / 0062_Alpha Sort of chars in strings.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-29  |  2.4 KB  |  83 lines
  1. {
  2. Here's a solution in Borland Pascal 7.0 to your sorting problem. However, it
  3. does one things slightly different from what you might expect: It uses
  4. ASCIIbetical order, ie. spaces come before letters.
  5.  
  6. I hope you can adapt the program to your needs (your specific compiler etc).
  7. The program uses Strings, but you can substitute them with Array [1..255] of
  8. Char (of course, the displaying part should be changed). If you need the new
  9. indices, try moving the P array out of the DoSort procedure.
  10.  
  11. Hope this helps.
  12. Andy Kurnia
  13.  
  14. -----Sample output for input: THIS IS AN EXAMPLE ARRAY OF BYTES-----
  15.  
  16. -----SORTING.PAS, 1,742 bytes, Borland Pascal 7.0-----
  17. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y-}
  18. {$M 4096,0,0}
  19.  
  20. Program Sorting;
  21.  
  22. Var
  23.     S : String;
  24.  
  25. Function GetRow(X : Byte) : String;
  26. Var
  27.     T : String;
  28. Begin
  29.     If S[0] = ^@ Then Begin             { Zero-length string check }
  30.         GetRow := '';
  31.         Exit
  32.     End
  33.     Else If X = 0 Then                  { Row 0 check }
  34.         X := Length(S);
  35.     T := S;
  36.     Delete(T, 1, (X - 1) Mod Length(S));
  37.     T := T + S;
  38.     T[0] := S[0];                       { Cut unnecessary extra characters }
  39.     GetRow := T
  40. End;
  41.  
  42. Var
  43.     A1, A2, A3, A4 : String;            { Strings are Array Of Char }
  44.  
  45. Procedure DoSort;
  46. Var
  47.     I, J : Byte;
  48.     P : Array[1..255] Of Byte;          { Pointers to sorted position }
  49. Begin
  50.     A1 := S;
  51.     A2 := S[Length(S)] + Copy(S, 1, Length(S) - 1);
  52.     For I := 1 To 255 Do
  53.         P[I] := I;
  54.     For I := 1 To Length(S) - 1 Do      { The good old bubble sort }
  55.         For J := I + 1 To Length(S) Do
  56.             If GetRow(P[I]) > GetRow(P[J]) Then Begin
  57.                 P[I] := P[I] Xor P[J];  { Exchange P[I] with P[J] }
  58.                 P[J] := P[I] Xor P[J];
  59.                 P[I] := P[I] Xor P[J]
  60.             End;
  61.     A3[0] := S[0];                      { Copy just the length bytes }
  62.     A4[0] := S[0];
  63.     For I := 1 To Length(S) Do Begin    { Lay the results out }
  64.         A3[I] := A1[P[I]];
  65.         A4[I] := A2[P[I]]
  66.     End
  67. End;
  68.  
  69. Var
  70.     I : Byte;
  71. Begin
  72.     Write('Enter test string: ');
  73.     ReadLn(S);
  74.     WriteLn('The matrix of strings:');
  75.     For I := 1 To Length(S) Do
  76.         WriteLn(GetRow(I));
  77.     DoSort;
  78.     WriteLn('[A1] = ', A1);
  79.     WriteLn('[A2] = ', A2);
  80.     WriteLn('[A3] = ', A3);
  81.     WriteLn('[A4] = ', A4)
  82. End.
  83.